home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / i-cpoint.adb < prev    next >
Text File  |  1996-01-30  |  7KB  |  248 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                I N T E R F A C E S . C . P O I N T E R S                 --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.3 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Interfaces.C.Strings; use Interfaces.C.Strings;
  27. with System;               use System;
  28.  
  29. with Unchecked_Conversion;
  30.  
  31. package body Interfaces.C.Pointers is
  32.  
  33.    type Addr is mod Memory_Size;
  34.  
  35.    function To_Pointer is new Unchecked_Conversion (Addr,      Pointer);
  36.    function To_Addr    is new Unchecked_Conversion (Pointer,   Addr);
  37.    function To_Addr    is new Unchecked_Conversion (ptrdiff_t, Addr);
  38.    function To_Ptrdiff is new Unchecked_Conversion (Addr,      ptrdiff_t);
  39.  
  40.    Elmt_Size : ptrdiff_t :=
  41.                  (Element'Size + Storage_Unit - 1) / Storage_Unit;
  42.  
  43.    subtype Index_Base is Index'Base;
  44.  
  45.    ---------
  46.    -- "+" --
  47.    ---------
  48.  
  49.    function "+" (Left : in Pointer;   Right : in ptrdiff_t) return Pointer is
  50.    begin
  51.       return To_Pointer (To_Addr (Left) + To_Addr (Right));
  52.    end "+";
  53.  
  54.    function "+" (Left : in ptrdiff_t; Right : in Pointer) return Pointer is
  55.    begin
  56.       return To_Pointer (To_Addr (Left) + To_Addr (Right));
  57.    end "+";
  58.  
  59.    ---------
  60.    -- "-" --
  61.    ---------
  62.  
  63.    function "-" (Left : in Pointer; Right : in ptrdiff_t) return Pointer is
  64.    begin
  65.       return To_Pointer (To_Addr (Left) - To_Addr (Right));
  66.    end "-";
  67.  
  68.  
  69.    function "-" (Left : in Pointer; Right : in Pointer) return ptrdiff_t is
  70.    begin
  71.       return To_Ptrdiff (To_Addr (Left) - To_Addr (Right));
  72.    end "-";
  73.  
  74.    ----------------
  75.    -- Copy_Array --
  76.    ----------------
  77.  
  78.    procedure Copy_Array
  79.      (Source  : in Pointer;
  80.       Target  : in Pointer;
  81.       Length  : in ptrdiff_t)
  82.    is
  83.       S : Pointer := Target;
  84.       T : Pointer := Source;
  85.  
  86.    begin
  87.       if S = null or else T = null then
  88.          raise Dereference_Error;
  89.  
  90.       else
  91.          for J in 1 .. Length loop
  92.             T.all := S.all;
  93.             Increment (T);
  94.             Increment (S);
  95.          end loop;
  96.       end if;
  97.    end Copy_Array;
  98.  
  99.    ---------------------------
  100.    -- Copy_Terminated_Array --
  101.    ---------------------------
  102.  
  103.    procedure Copy_Terminated_Array
  104.      (Source     : in Pointer;
  105.       Target     : in Pointer;
  106.       Limit      : in ptrdiff_t := ptrdiff_t'Last;
  107.       Terminator : in Element := Default_Terminator)
  108.    is
  109.       S : Pointer   := Source;
  110.       T : Pointer   := Target;
  111.       L : ptrdiff_t := Limit;
  112.  
  113.    begin
  114.       if S = null or else T = null then
  115.          raise Dereference_Error;
  116.  
  117.       else
  118.          while S.all /= Terminator and then L > 0 loop
  119.             T.all := S.all;
  120.             Increment (T);
  121.             Increment (S);
  122.             L := L - 1;
  123.          end loop;
  124.       end if;
  125.    end Copy_Terminated_Array;
  126.  
  127.    ---------------
  128.    -- Decrement --
  129.    ---------------
  130.  
  131.    procedure Decrement (Ref : in out Pointer) is
  132.    begin
  133.       Ref := Ref - Elmt_Size;
  134.    end Decrement;
  135.  
  136.    ---------------
  137.    -- Increment --
  138.    ---------------
  139.  
  140.    procedure Increment (Ref : in out Pointer) is
  141.    begin
  142.       Ref := Ref + Elmt_Size;
  143.    end Increment;
  144.  
  145.    -----------
  146.    -- Value --
  147.    -----------
  148.  
  149.    function Value
  150.      (Ref        : in Pointer;
  151.       Terminator : in Element := Default_Terminator)
  152.       return       Element_Array
  153.    is
  154.       P : Pointer;
  155.       L : constant Index_Base := Index'First;
  156.       H : Index_Base;
  157.  
  158.    begin
  159.       if Ref = null then
  160.          raise Dereference_Error;
  161.  
  162.       else
  163.          if Ref.all = Terminator then
  164.             H := Index_Base'Pred (Index'First);
  165.  
  166.          else
  167.             H := L;
  168.             P := Ref;
  169.  
  170.             loop
  171.                Increment (P);
  172.                exit when P.all = Terminator;
  173.                H := Index_Base'Succ (H);
  174.             end loop;
  175.          end if;
  176.  
  177.          declare
  178.             subtype A is Element_Array (L .. H);
  179.  
  180.             type PA is access A;
  181.             function To_PA is new Unchecked_Conversion (Pointer, PA);
  182.  
  183.          begin
  184.             return To_PA (Ref).all;
  185.          end;
  186.       end if;
  187.    end Value;
  188.  
  189.    function Value
  190.      (Ref    : in Pointer;
  191.       Length : in ptrdiff_t)
  192.       return   Element_Array
  193.    is
  194.       P : Pointer;
  195.       L : Index_Base;
  196.       H : Index_Base;
  197.  
  198.    begin
  199.       if Ref = null then
  200.          raise Dereference_Error;
  201.  
  202.       else
  203.          L := Index'First;
  204.          H := Index'Val (Index'Pos (Index'First) - 1 + Length);
  205.  
  206.          declare
  207.             subtype A is Element_Array (L .. H);
  208.  
  209.             type PA is access A;
  210.             function To_PA is new Unchecked_Conversion (Pointer, PA);
  211.  
  212.          begin
  213.             return To_PA (Ref).all;
  214.          end;
  215.       end if;
  216.    end Value;
  217.  
  218.    --------------------
  219.    -- Virtual_Length --
  220.    --------------------
  221.  
  222.    function Virtual_Length
  223.      (Ref        : in Pointer;
  224.       Terminator : in Element := Default_Terminator)
  225.       return       ptrdiff_t
  226.    is
  227.       P : Pointer;
  228.       C : ptrdiff_t;
  229.  
  230.    begin
  231.       if Ref = null then
  232.          raise Dereference_Error;
  233.  
  234.       else
  235.          C := 0;
  236.          P := Ref;
  237.  
  238.          while P.all /= Terminator loop
  239.             C := C + 1;
  240.             Increment (P);
  241.          end loop;
  242.  
  243.          return C;
  244.       end if;
  245.    end Virtual_Length;
  246.  
  247. end Interfaces.C.Pointers;
  248.